-- CIS 552, Homework assignment 11

-- Name(s): David Siegel
-- Approximate time spent on this assignment: 2 hours

module FiniteChan (
  FiniteChan
, newFiniteChan
, readFiniteChan
, writeFiniteChan
) where

import Control.Monad
import Control.Concurrent.STM

type Size = Int
data FiniteChan a = FiniteChan Size (TVar [a])

-- Construct a new FiniteChan of bounded size.
newFiniteChan :: Int -> IO (FiniteChan a)
newFiniteChan size
  = do q' <- newTVarIO []
       return $ FiniteChan size q'

-- Reads the next available element in a FiniteChan. Will retry until element
-- is available.
readFiniteChan :: FiniteChan a -> IO a
readFiniteChan (FiniteChan _ q') = atomically readSTM
    where readSTM = do q <- readTVar q'
                       when (length q == 0) retry
                       writeTVar q' (tail q)
                       return (head q)

-- Puts an element into a FiniteChan. Will retry until empty slot is available.
writeFiniteChan :: FiniteChan a -> a -> IO ()
writeFiniteChan (FiniteChan size q') x = atomically writeSTM
      where writeSTM = do q <- readTVar q'
                          when (length q == size) retry
                          writeTVar q' (q ++ [x])
